home *** CD-ROM | disk | FTP | other *** search
- 4 DEFINT A-W,Y-Z
- 5 DIM F$(15),FLDN$(17,40),FTY(17,40),FL(17,40)
- 13 DIM L(17),NREC(17)
- 16 DIM KY(17,40),KEYLIST(17,40)
- 35 DIM K$(80)
- 40 DIM IDEXA(30),IDEXB(30),IDEXC(30),MFLG(30)
- 50 DIM MIND#(30),MAXD#(30)
- 60 DIM REALFLG(30)
- 70 CH = 29
- 75 PRINT FRE(0)
- 80 GOSUB 52000
- 100 GOSUB 50000
- 150 GOSUB 24000
- 200 GOTO 40000
- 500 REM ******* CLS
- 510 CLS
- 520 RETURN
- 20000 REM ****** SHOW REALTIME DATA ON SCREEN
- 20100 GOSUB 500
- 20110 PRINT "TRANSFER DATA TO FILE : ";F$(TFILE)
- 20120 IF TGTRN = 0 THEN PRINT " TARGET RECORD NUMBER ALWAYS EQUALS ONE "
- 20130 IF TGTRN > 0 THEN PRINT "TARGET RECORD NUMBER = VALUE OF THIS FIELD : ";FLDN$(A,TGTRN)
- 20140 PRINT "TRANSFER THIS FIELD : ";FLDN$(A,FLD1)
- 20150 PRINT "TO THIS FIELD IN TARGET FILE : ";FLDN$(TFILE,TFLD1)
- 20160 IF ADSUB1 = 1 THEN PRINT "ADD" ELSE PRINT "SUBTRACT"
- 20170 IF TFLD2 = 0 THEN 20400
- 20180 PRINT "SECOND TRANSFER TO THIS FIELD : ";FLDN$(TFILE,TFLD2)
- 20190 IF ADSUB2 = 1 THEN PRINT "ADD" ELSE PRINT "SUBTRACT"
- 20400 REM
- 20500 IF FLD2 = 0 THEN 20700
- 20510 PRINT ""
- 20520 PRINT "**** SECOND SOURCE FILE TRANSFER ****"
- 20640 PRINT "TRANSFER THIS FIELD : ";FLDN$(A,FLD2)
- 20650 PRINT "TO THIS FIELD IN TARGET FILE : ";FLDN$(TFILE,TFLD3)
- 20660 IF ADSUB3 = 1 THEN PRINT "ADD" ELSE PRINT "SUBTRACT"
- 20670 IF TFLD3 = 0 THEN 20700
- 20680 PRINT "SECOND TRANSFER TO THIS FIELD : ";FLDN$(TFILE,TFLD4)
- 20690 IF ADSUB4 = 1 THEN PRINT "ADD" ELSE PRINT "SUBTRACT"
- 20700 PRINT "******* PRESS ANY KEY TO CONTINUE ********"
- 20750 IF INKEY$ = "" THEN 20750
- 20800 RETURN
- 21000 REM ****** SHOW REALTIME DATA ON SCREEN
- 21100 GOSUB 500
- 21110 LPRINT "TRANSFER DATA TO FILE : ";F$(TFILE)
- 21120 IF TGTRN = 0 THEN LPRINT " TARGET RECORD NUMBER ALWAYS EQUALS ONE "
- 21130 IF TGTRN > 0 THEN LPRINT "TARGET RECORD NUMBER = VALUE OF THIS FIELD ";FLDN$(A,TGTRN)
- 21140 LPRINT "TRANSFER THIS FIELD : ";FLDN$(A,FLD1)
- 21150 LPRINT "TO THIS FIELD IN TARGET FILE : ";FLDN$(TFILE,TFLD1)
- 21160 IF ADSUB1 = 1 THEN LPRINT "ADD" ELSE LPRINT "SUBTRACT"
- 21170 IF TFLD2 = 0 THEN 20400
- 21180 LPRINT "SECOND TRANSFER TO THIS FIELD : ";FLDN$(TFILE,TFLD2)
- 21190 IF ADSUB2 = 1 THEN LPRINT "ADD" ELSE LPRINT "SUBTRACT"
- 21400 REM
- 21500 IF FLD2 = 0 THEN 20700
- 21510 LPRINT ""
- 21520 LPRINT "**** SECOND SOURCE FILE TRANSFER ****"
- 21640 LPRINT "TRANSFER THIS FIELD : ";FLDN$(A,FLD2)
- 21650 LPRINT "TO THIS FIELD IN TARGET FILE : ";FLDN$(TFILE,TFLD3)
- 21660 IF ADSUB3 = 1 THEN LPRINT "ADD" ELSE LPRINT "SUBTRACT"
- 21670 IF TFLD3 = 0 THEN 20700
- 21680 LPRINT "SECOND TRANSFER TO THIS FIELD : ";FLDN$(TFILE,TFLD4)
- 21690 IF ADSUB4 = 1 THEN LPRINT "ADD" ELSE LPRINT "SUBTRACT"
- 21700 PRINT "******* PRESS ANY KEY TO CONTINUE ********"
- 21800 RETURN
- 23780 REM ************* READ SUBROUTINE *************
- 23800 OPEN "I",#1,"FFILE"
- 23820 INPUT #1,MAXF
- 23840 FOR A = 1 TO MAXF
- 23860 INPUT #1,A,F$(A),NREC(A),L(A)
- 23880 FOR N = 1 TO NREC(A)
- 23900 INPUT #1,FLDN$(A,N),FTY(A,N),FL(A,N)
- 23920 IF FTY(A,N) = 2 THEN INPUT #1,KY(A,N),KEYLIST(A,N)
- 23940 NEXT N
- 23960 NEXT A
- 23980 CLOSE #1
- 23990 RETURN
- 24000 REM ********** READ IDEX SUBROUTINE
- 24100 OPEN "I",#1,"REALTIME"
- 24110 FOR T = 1 TO MAXF
- 24120 INPUT #1,REALFLG(T)
- 24130 NEXT T
- 24140 CLOSE #1
- 24150 RETURN
- 25000 REM ********** WRITE IDEX SUBROUTINE
- 25100 OPEN "O",#1,"REALTIME"
- 25110 FOR T = 1 TO 30
- 25120 WRITE #1,REALFLG(T)
- 25130 NEXT T
- 25140 CLOSE #1
- 25150 RETURN
- 25400 REM
- 26000 REM *********** READ MAX MIN DATA
- 26100 A$ = STR$(A)
- 26110 A$ = MID$(A$,2)
- 26120 A$ = "REAL" + A$
- 26200 OPEN "I",#1,A$
- 26220 INPUT #1,TFILE,FLD1,FLD2,TFLD1,TFLD2,TFLD3,TFLD4,ADSUB1,ADSUB2,ADSUB3,ADSUB4,TGTRN
- 26240 CLOSE #1
- 26250 RETURN
- 27000 REM *********** WRITEMAX MIN DATA
- 27100 A$ = STR$(A)
- 27110 A$ = MID$(A$,2)
- 27120 A$ = "REAL" + A$
- 27200 OPEN "O",#1,A$
- 27220 WRITE #1,TFILE,FLD1,FLD2,TFLD1,TFLD2,TFLD3,TFLD4,ADSUB1,ADSUB2,ADSUB3,ADSUB4,TGTRN
- 27240 CLOSE #1
- 27250 RETURN
- 28000 REM ********** READ IDEX SUBROUTINE
- 28100 GOSUB 500
- 28105 PRINT "FILE REALTIME TRANSFER"
- 28110 FOR T = 1 TO MAXF
- 28120 PRINT T;
- 28122 IF REALFLG(T) = 2 THEN PRINT TAB(15)"YES" ELSE PRINT TAB(15)"NO"
- 28130 NEXT T
- 28150 RETURN
- 29000 REM ********** LPRINT IDEX SUBROUTINE
- 29100 GOSUB 500
- 29105 LPRINT "FILE REALTIME OPTION "
- 29110 FOR T = 1 TO MAXF
- 29120 LPRINT T;
- 29122 IF REALFLG(T) = 2 THEN LPRINT TAB(15)"YES" ELSE LPRINT TAB(15)"NO"
- 29130 NEXT T
- 29150 RETURN
- 30000 REM ****** INPUT REALTIME DATA
- 30100 GOSUB 500
- 30110 PRINT "***** WHAT FILE DO YOU WANT TO TRANSFER THE DATA TO *****"
- 30120 FOR T = 1 TO MAXF
- 30130 PRINT T;" - ";F$(T)
- 30140 NEXT T
- 30150 GOSUB 60000
- 30160 IF DT# < 1 OR DT# >MAXF THEN 30150
- 30170 TFILE = DT#
- 30200 GOSUB 500
- 30210 PRINT "***** WHAT IS THE FIRST FIELD YOU WANT TRANSFERED *****"
- 30220 FOR T = 1 TO NREC(A)
- 30230 PRINT T;" - ";FLDN$(A,T)
- 30240 NEXT T
- 30250 PRINT "***** WHAT IS THE FIRST FIELD YOU WANT TRANSFERED *****"
- 30260 GOSUB 60000
- 30270 IF DT# < 1 OR DT# > NREC(A) THEN 30260
- 30275 IF FTY(A,DT#) < 4 THEN 30260
- 30280 FLD1 = DT#
- 30285 PRINT "***** WHAT FIELD VALUE IS THE RECORD NUMBER OF THE TARGET FILE *****"
- 30287 PRINT " enter zero if the target record number is always one "
- 30290 GOSUB 60000
- 30292 IF DT# < 0 OR DT# > NREC(A) THEN 30290
- 30295 TGTRN = DT#
- 30300 GOSUB 500
- 30310 FOR T = 1 TO NREC(TFILE)
- 30320 PRINT T;" - ";FLDN$(TFILE,T)
- 30330 NEXT T
- 30340 PRINT "***** WHICH FIELD IS THE FIRST FIELD YOU WANT THE DATA TRANSFERED TO ****"
- 30350 GOSUB 60000
- 30360 IF DT# < 1 OR DT# > NREC(TFILE) THEN 30350
- 30365 IF FTY(TFILE,DT#) < 4 THEN 30350
- 30370 TFLD1 = DT#
- 30380 PRINT "DO YOU WANT THE DATA TO BE 1-ADDED OR 2-SUBTRACTED FROM THIS FIELD"
- 30385 GOSUB 60000
- 30390 IF DT# < 1 OR DT# > 2 THEN 30385
- 30400 ADSUB1 = DT#
- 30420 PRINT "WHICH FIELD IS THE SECOND FIELD YOU WANT TO TRANSFER THE DATA TO - 0 FOR NONE"
- 30430 GOSUB 60000
- 30433 IF DT# = 0 THEN TFLD2 = 0
- 30435 IF DT# = 0 THEN 31200
- 30440 IF DT# < 0 OR DT# > NREC(TFILE) THEN 30430
- 30445 IF FTY(TFILE,DT#) < 4 THEN 30430
- 30450 TFLD2 = DT#
- 30460 PRINT "DO YOU WANT THE DATA 1-ADDED OR 2-SUBTRACTED FROM THIS FIELD "
- 30470 GOSUB 60000
- 30480 IF DT# < 1 OR DT# > 2 THEN 30470
- 30490 ADSUB2 = DT#
- 31200 GOSUB 500
- 31210 PRINT "***** WHAT IS THE SECOND FIELD YOU WANT TRANSFERED *****"
- 31220 FOR T = 1 TO NREC(A)
- 31230 PRINT T;" - ";FLDN$(A,T)
- 31240 NEXT T
- 31250 PRINT "***** WHAT IS THE SECOND FIELD YOU WANT TRANSFERED *****"
- 31255 PRINT " ENTER ZERO IF YOU DO NOT WANT A SECOND FIELD TRANSFERED "
- 31260 GOSUB 60000
- 31270 IF DT# < 0 OR DT# > NREC(A) THEN 31260
- 31271 IF DT# = 0 THEN FLD2 = 0
- 31272 IF DT# = 0 THEN RETURN
- 31275 IF FTY(A,DT#) < 4 THEN 31260
- 31280 FLD2 = DT#
- 31300 GOSUB 500
- 31310 FOR T = 1 TO NREC(TFILE)
- 31320 PRINT T;" - ";FLDN$(TFILE,T)
- 31330 NEXT T
- 31340 PRINT "***** WHICH FIELD IS THE FIRST FIELD YOU WANT THE DATA TRANSFERED TO ****"
- 31350 GOSUB 60000
- 31360 IF DT# < 1 OR DT# > NREC(TFILE) THEN 31350
- 31365 IF FTY(TFILE,DT#) < 4 THEN 31350
- 31370 TFLD3 = DT#
- 31380 PRINT "DO YOU WANT THE DATA TO BE 1-ADDED OR 2-SUBTRACTED FROM THIS FIELD"
- 31385 GOSUB 60000
- 31390 IF DT# < 1 OR DT# > 2 THEN 31385
- 31400 ADSUB3 = DT#
- 31420 PRINT "WHICH FIELD IS THE SECOND FIELD YOU WANT TO TRANSFER THE DATA TO - 0 FOR NONE"
- 31430 GOSUB 60000
- 31433 IF DT# = 0 THEN TFLD4 = 0
- 31435 IF DT# = 0 THEN RETURN
- 31440 IF DT# < 0 OR DT# > NREC(TFILE) THEN 31430
- 31445 IF FTY(TFILE,DT#) < 4 THEN 31430
- 31450 TFLD4 = DT#
- 31460 PRINT "DO YOU WANT THE DATA 1-ADDED OR 2-SUBTRACTED FROM THIS FIELD "
- 31470 GOSUB 60000
- 31480 IF DT# < 1 OR DT# > 2 THEN 31270
- 31490 ADSUB4 = DT#
- 31900 RETURN
- 40000 REM ****** INITIAL MENU
- 40100 GOSUB 500
- 40110 PRINT "********************** INITIAL MENU ************************"
- 40120 PRINT " 0 - EXIT PROGRAM "
- 40130 PRINT " 1 - TURN REALTIME OFF OR ON "
- 40140 PRINT " 2 - SHOW REALTIME DATA ON SCREEN"
- 40150 PRINT " 3 - SHOW REALTIME OPTION FOR EACH FILE ON SCREEN"
- 40160 PRINT " 4 - PRINT REALTIME DATA ON PAPER"
- 40170 PRINT " 5 - PRINT REALTIME OPTION FOR EACH FILE ON PAPER"
- 40180 PRINT " 6 - ENTER REALTIME DATA FOR A FILE "
- 40200 PRINT "************ ENTER THE NUMBER THEN PRESS RETURN ************"
- 40210 GOSUB 60000
- 40220 IF DT# < 0 OR DT# > 7 THEN 40210
- 40230 T = DT#
- 40240 IF T = 0 THEN GOTO 51000
- 40250 ON T GOTO 41000,42000,43000,44000,45000,46000,47000
- 41000 REM ******** TURN REALTIME OPTION ON OR OFF
- 41100 GOSUB 500
- 41110 GOSUB 56000
- 41180 GOSUB 500
- 41500 PRINT "**** DO YOU WANT REALTIME TRANSFER ****"
- 41510 PRINT " 1 - NO "
- 41520 PRINT " 2 - YES"
- 41530 PRINT "*** ENTER THE NUMBER THEN PRESS RETURN ***"
- 41540 GOSUB 60000
- 41550 REALFLG(A) = DT#
- 41700 GOSUB 25000
- 41710 GOTO 40000
- 42000 REM ******** SHOW REALTIME DATA ON SCREEN
- 42040 GOSUB 500
- 42050 GOSUB 56000
- 42055 IF REALFLG(A) <> 2 THEN 40000
- 42060 GOSUB 26000
- 42100 GOSUB 500
- 42200 GOSUB 20000
- 42300 GOTO 40000
- 43000 REM ******** SHOW REALTIME DATA ON SCREEN
- 43100 GOSUB 28000
- 43150 PRINT "****** PRESS ANY KEY TO CONTINUE ******"
- 43200 IF INKEY$ = "" THEN 43200
- 43300 GOTO 40000
- 44000 REM ******** PRINT MAXIMUM AND MINIMUMS ON PAPER
- 44040 GOSUB 500
- 44050 GOSUB 56000
- 44055 IF REALFLG(A) <> 2 THEN 40000
- 44060 GOSUB 26000
- 44100 GOSUB 500
- 44200 GOSUB 21000
- 44300 GOTO 40000
- 45000 REM ******** PRINT INDEX FIELDS AND MAX OPTION ON PAPER
- 45100 GOSUB 29000
- 45300 GOTO 40000
- 46000 REM ******* ENTER REALTIME DATA FOR A FILE
- 46100 GOSUB 500
- 46110 GOSUB 56000
- 46190 GOSUB 30000
- 46210 GOSUB 27000
- 46300 GOTO 40000
- 47000 REM ******** CHANGE THE MAXIMUMS AND MINIMUMS FOR A SINGLE FIELD
- 47100 GOSUB 500
- 47110 GOSUB 56000
- 47115 GOSUB 26000
- 47120 GOSUB 500
- 47130 PRINT "**** WHAT FIELD DO YOU WANT TO CHANGE THE MAXIMUMS AND MINIMUMS ****"
- 47180 FOR T = 1 TO NREC(A)
- 47185 PRINT T;" - ";FLDN$(A,T)
- 47200 NEXT T
- 47210 PRINT "***** ENTER THE NUMBER THEN PRESS RETURN *****"
- 47220 GOSUB 60000
- 47230 IF DT# < 1 OR DT# > NREC(A) THEN 47220
- 47240 T = DT#
- 47250 GOSUB 30000
- 47810 GOSUB 27000
- 47900 GOTO 40000
- 50000 REM ********** INTRO
- 50010 GOSUB 500
- 50100 PRINT " R E A L T I M E P R O G R A M 3.0 "
- 50105 PRINT ""
- 50110 PRINT " Copyright 1984 by Potomac Pacific Engineering Inc."
- 50120 PRINT ""
- 50130 PRINT "This program is licensed FREE to all users with some restrictions "
- 50165 PRINT " See the manual for more information on the license."
- 50167 PRINT ""
- 50920 GOSUB 23780
- 50950 PRINT "****************** PRESS ANY KEY TO CONTINUE *******************";
- 50960 IF INKEY$ = "" GOTO 50960
- 50970 RETURN
- 51000 REM ***** EXIT TO SYSTEM
- 51100 GOSUB 500
- 51110 CLOSE
- 51120 PRINT " -BYE, Have a nice day"
- 51130 END
- 52000 REM ***** INTRO 1
- 52010 GOSUB 500
- 52100 PRINT " Put the DATA DISK in the default disk drive "
- 52110 PRINT ""
- 52120 PRINT " ***** THEN PRESS ANY KEY TO CONTINUE *****"
- 52130 PRINT ""
- 52140 PRINT " The CUSTOM programs only use the PROGRAM DATA DISK"
- 52150 PRINT "Keep it in the default disk drive at all times during this program."
- 52200 IF INKEY$ = "" GOTO 52200
- 52210 RETURN
- 56000 REM **** WHAT FILE
- 56105 PRINT "*********** WHICH FILE DO YOU WANT ************"
- 56110 FOR T = 1 TO MAXF
- 56120 PRINT T;" - ";F$(T)
- 56130 NEXT T
- 56140 PRINT "****** ENTER THE NUMBER THEN PRESS RETURN *****"
- 56150 GOSUB 60000
- 56160 IF DT# < 1 OR DT# > MAXF THEN 56150
- 56170 A = DT#
- 56200 RETURN
- 60000 REM ******* INTEGER LESS THEN 100 CHECK ********
- 60010 MAX = 2
- 60020 ACT$ = "1234567890=<>^"
- 60030 IF NE = 0 THEN ACT$ = "1234567890"
- 60040 PRINT ">__<";
- 60050 GOTO 60240
- 60060 REM ******* INTEGER *******
- 60070 MAX = 8
- 60080 ACT$ = "1234567890-+,=<>^"
- 60090 IF NE = 0 THEN ACT$ = "1234567890-+,"
- 60100 PRINT ">________<";
- 60110 GOTO 60240
- 60120 REM ******* SINGLE PRECISION *******
- 60130 MAX = 10
- 60140 ACT$ = "1234567890-+,.%$=<>^"
- 60150 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
- 60160 PRINT ">__________<";
- 60170 GOTO 60240
- 60180 REM ******* DOUBLE PRECISION *******
- 60190 MAX = 20
- 60200 ACT$ = "1234567890-+,.%$=<>^"
- 60210 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
- 60220 PRINT ">____________________<";
- 60230 GOTO 60240
- 60240 REM ********** NUMBER CHECK **********
- 60250 A$ = ""
- 60260 K$(20) = " "
- 60270 KTMAX = 0
- 60280 FOR T9 = 1 TO MAX
- 60290 K$(T9) = " "
- 60300 NEXT T9
- 60310 DIG$ = "1234567890."
- 60320 DOTFLG = 0
- 60330 T2 = MAX + 1
- 60340 FOR T6 = 1 TO T2
- 60350 PRINT CHR$(CH);
- 60360 NEXT T6
- 60370 IF INKEY$ = "" GOTO 60380 ELSE GOTO 60370
- 60380 KT = 0
- 60390 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH ***********
- 60400 KT = KT + 1
- 60410 REM
- 60420 W$ = INKEY$
- 60430 IF W$ = "" GOTO 60420
- 60440 C = ASC(W$)
- 60450 IF C = 0 THEN GOSUB 61900
- 60460 IF C = 13 GOTO 60580
- 60470 IF C = 17 OR C = 8 GOTO 61150
- 60480 IF C = 19 GOTO 60670
- 60490 IF C = 4 GOTO 60720
- 60500 IF C = 6 GOTO 60780
- 60510 IF C = 1 GOTO 60960
- 60520 IF KT > MAX GOTO 60410
- 60530 IF INSTR(ACT$,W$) = 0 GOTO 61230
- 60540 K$(KT) = W$
- 60550 PRINT K$(KT);
- 60560 IF KT > KTMAX THEN KTMAX = KT
- 60570 GOTO 60400
- 60580 REM ********** RETURN **********
- 60590 FOR T9 = 1 TO KTMAX
- 60600 A$ = A$ + K$(T9)
- 60610 NEXT T9
- 60620 IF KTMAX = 0 THEN PRINT "1"
- 60630 IF KTMAX = 0 THEN DT# = 1
- 60640 IF KTMAX = 0 THEN RETURN
- 60650 PRINT ""
- 60660 GOTO 61260
- 60670 REM ********* MOVE CURSE BACK ********
- 60680 IF KT = 1 GOTO 60410
- 60690 KT = KT - 1
- 60700 PRINT CHR$(CH);
- 60710 GOTO 60410
- 60720 REM ********* MOVE CURSER FORWARD *********
- 60730 IF KT >= MAX GOTO 60410
- 60740 IF KT > (KTMAX + 1) GOTO 60410
- 60750 PRINT K$(KT);
- 60760 KT = KT + 1
- 60770 GOTO 60410
- 60780 REM ********** INSERT ***********
- 60790 IF KT > KTMAX GOTO 60410
- 60800 X9 = MAX
- 60810 WHILE X9 > KT
- 60820 X9 = X9 - 1
- 60830 K$(X9 + 1) = K$(X9)
- 60840 WEND
- 60850 K$(KT) = " "
- 60860 KTMAX = KTMAX + 1
- 60870 IF KTMAX > MAX THEN KTMAX = MAX
- 60880 FOR T9 = KT TO KTMAX
- 60890 PRINT K$(T9);
- 60900 NEXT T9
- 60910 T6 = (KTMAX - KT) + 1
- 60920 FOR T7 = 1 TO T6
- 60930 PRINT CHR$(CH);
- 60940 NEXT T7
- 60950 GOTO 60410
- 60960 REM ********** DELETE ***********
- 60970 IF KT > KTMAX GOTO 60410
- 60980 IF KTMAX = 1 GOTO 60410
- 60990 K$(MAX + 1) = ""
- 61000 X9 = KT
- 61010 WHILE X9 <= MAX
- 61020 K$(X9) = K$(X9 + 1)
- 61030 X9 = X9 + 1
- 61040 WEND
- 61050 KTMAX = KTMAX - 1
- 61060 FOR T9 = KT TO KTMAX
- 61070 PRINT K$(T9);
- 61080 NEXT T9
- 61090 PRINT "_";
- 61100 T7 = (KTMAX - KT) + 2
- 61110 FOR T8 = 1 TO T7
- 61120 PRINT CHR$(CH);
- 61130 NEXT T8
- 61140 GOTO 60410
- 61150 REM ********* BACKSPACE ********
- 61160 IF KT = 1 GOTO 60410
- 61170 KT = KT - 1
- 61180 PRINT CHR$(CH);
- 61190 K$(KT) = " "
- 61200 PRINT "_";
- 61210 PRINT CHR$(CH);
- 61220 GOTO 60410
- 61230 REM ******* INPUT NOT ACCEPTABLE ********
- 61240 PRINT CHR$(7);
- 61250 GOTO 60420
- 61260 REM ********* CLEAR STRINGS ********
- 61270 MAX = LEN(A$)
- 61280 D2$ = ""
- 61290 D1$ = ""
- 61300 DFLG = 0
- 61310 FOR Q93 = 1 TO MAX
- 61320 R$ = MID$(A$,Q93,1)
- 61330 IF INSTR(DIG$,R$) = 0 GOTO 61400
- 61340 IF R$ = "." OR DFLG = 1 GOTO 61380
- 61350 IF DFLG = 1 GOTO 61380
- 61360 D2$ = D2$ + R$
- 61370 GOTO 61400
- 61380 D1$ = D1$ + R$
- 61390 DFLG = 1
- 61400 NEXT Q93
- 61410 DA# = VAL(D2$)
- 61420 D1# = VAL(D1$)
- 61430 DT# = DA# + D1#
- 61440 IF K$(1) = "-" THEN DT# = -DT#
- 61450 RETURN
- 61900 REM ****** CHECK FOR ASC0
- 61910 S4$ = INKEY$
- 61920 C2 = ASC(S4$)
- 61930 IF C2 = 83 THEN C = 1
- 61940 IF C2 = 82 THEN C = 6
- 61950 IF C2 = 75 THEN C = 19
- 61960 IF C2 = 77 THEN C = 4
- 61970 RETURN
- 62000 REM ********** ALPHANUMERIC CHECK **************
- 62010 MAX = FL(A,Q)
- 62020 GOTO 62040
- 62030 REM ******** MAX SET IN PROGRAM ********
- 62040 A$ = ""
- 62050 PRINT ">";
- 62060 FOR N9 = 1 TO MAX
- 62070 K$(N9) = ""
- 62080 PRINT "_";
- 62090 NEXT N9
- 62100 PRINT "<";
- 62110 T2 = MAX + 1
- 62120 FOR T4 = 1 TO T2
- 62130 PRINT CHR$(CH);
- 62140 NEXT T4
- 62150 KT = 0
- 62160 KTMAX = 1
- 62170 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH ***********
- 62180 KT = KT + 1
- 62190 PRINT TAB(KT+1)"";
- 62200 K$ = INKEY$
- 62210 IF K$ = "" GOTO 62200
- 62220 C = ASC(K$)
- 62230 IF C = 0 THEN GOSUB 61900
- 62240 IF C = 13 GOTO 62350
- 62250 IF C = 17 OR C = 8 GOTO 62920
- 62260 IF C = 19 GOTO 62450
- 62270 IF C = 4 GOTO 62500
- 62280 IF C = 6 GOTO 62560
- 62290 IF C = 1 GOTO 62730
- 62300 IF KT > MAX GOTO 62190
- 62310 K$(KT) = K$
- 62320 PRINT K$(KT);
- 62330 IF KT > KTMAX THEN KTMAX = KT
- 62340 GOTO 62180
- 62350 REM ********** RETURN **********
- 62360 FOR T9 = 1 TO MAX
- 62370 A$ = A$ + K$(T9)
- 62420 NEXT T9
- 62430 PRINT ""
- 62440 RETURN
- 62450 REM ********* MOVE CURSE BACK ********
- 62460 IF KT = 1 GOTO 62190
- 62470 KT = KT - 1
- 62480 PRINT CHR$(CH);
- 62490 GOTO 62190
- 62500 REM ********* MOVE CURSER FORWARD *********
- 62510 IF KT >= MAX GOTO 62190
- 62520 IF KT > KTMAX GOTO 62190
- 62530 PRINT K$(KT);
- 62540 KT = KT + 1
- 62550 GOTO 62190
- 62560 REM ********** INSERT ***********
- 62570 X9 = MAX
- 62580 WHILE X9 > KT
- 62590 X9 = X9 - 1
- 62600 K$(X9 + 1) = K$(X9)
- 62610 WEND
- 62620 K$(KT) = " "
- 62630 KTMAX = KTMAX + 1
- 62640 IF KTMAX > MAX THEN KTMAX = MAX
- 62650 FOR T9 = KT TO KTMAX
- 62660 PRINT K$(T9);
- 62670 NEXT T9
- 62680 T6 = (KTMAX - KT) +1
- 62690 FOR T7 = 1 TO T6
- 62700 PRINT CHR$(CH);
- 62710 NEXT T7
- 62720 GOTO 62190
- 62730 REM ********** DELETE ***********
- 62740 IF KT > KTMAX GOTO 62200
- 62750 IF KTMAX = 1 GOTO 62190
- 62760 K$(MAX + 1) = ""
- 62770 X9 = KT
- 62780 WHILE X9 <= KTMAX
- 62790 K$(X9) = K$(X9 + 1)
- 62800 X9 = X9 + 1
- 62810 WEND
- 62820 KTMAX = KTMAX - 1
- 62830 FOR T9 = KT TO KTMAX
- 62840 PRINT K$(T9);
- 62850 NEXT T9
- 62860 PRINT "_";
- 62870 T7 = (KTMAX - KT) + 2
- 62880 FOR T6 = 1 TO T7
- 62890 PRINT CHR$(CH);
- 62900 NEXT T6
- 62910 GOTO 62190
- 62920 REM ********* BACKSPACE ********
- 62930 IF KT = 1 GOTO 62190
- 62940 K$(KT) = " "
- 62950 KT = KT - 1
- 62960 K$(KT) = " "
- 62970 PRINT CHR$(CH);
- 62980 PRINT "_";
- 62990 PRINT CHR$(CH);
- 63000 GOTO 62190
- " "
- 62950 KT = KT - 1
- 62960 K$(KT) = " "
- 62